In[]:=
ParallelEvaluate[Needs["PostTagSystem`"]];
In[]:=
FindPostTagFinalPlus[{0,IntegerDigits[5854,2,13]}]
Out[]=
{341992,6,{0,{0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0}}}
In[]:=
FindPostTagFinal[{0,IntegerDigits[5854,2,13]}]
Out[]=
{341992,6}
In[]:=
FindPostTagFate[{0,IntegerDigits[5854,2,13]}]
Out[]=
{{18,{2,{1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0}}},1048584,16}
In[]:=
FindPostTagFate[{0,IntegerDigits[5854,2,13]},12]
Out[]=
{{TooBig,{1,{1,1,1,0,0,0,1,1,1,0,0,0,0,0,0,0,1,0,1,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,1,1,1,0,0,0,0,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,0,0,1,0,0,0,1,0,1,0,1,1,1,0,0,0,1,1,1,0,1,0,0,0,1,1,1,0,0,0,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,0,0,1,1,0,1,0,1,0,1,1,1,0,0,0,1,1,1,0,0,0,0,1,1,0,1,0,0,1,1,0,1,0,0,1,1,0,1,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,1,1,0,1,0,1,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,1,0,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,1,0,1,0,1,1,1,0,0,0,0,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,1,0,0,1,1,0,1,0,0,0,0,0,1,1,1,1,1,0,1,0,0,1,1,0,1,0,0,1,1,0,1,0,0,1,1,0,1,0,0,1,1,0,1,0,0,1,1,0,1,0,0,1,1,0,1,0,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,1,1,0,1,1,1,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0}}},65528,32768}
In[]:=
RandomInteger[1,50]
Out[]=
{1,0,1,0,1,1,1,0,1,0,0,0,0,1,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,1,0,1,0,1,1,1,0,0,0,0,1,0,0,0,0,0,1}
In[]:=
FindPostTagFinal[{0,%}]
Out[]=
{7216,6}
ParallelTry
FindPostTagFate[{0,IntegerDigits[5854,2,13]},12]
In[]:=
ParallelTable[With[{u=RandomInteger[2^50]},With[{v=FindPostTagFate[{0,IntegerDigits[u,2,50]}]},If[v[[1,1]]===TooBig,Echo[uv]];uv[[1,1]]]],10]
Out[]=
{83026328939007212,51429086215914117,104878933155172212,64954317989559611,16937493363923110,10285841434530127,4836031343724614,6248919530128989,93768666690799711,98407119116837410}
In[]:=
ParallelTable[With[{u=RandomInteger[2^50]},With[{v=FindPostTagFate[{0,IntegerDigits[u,2,50]}]},If[v[[1,1]]===TooBig,Echo[uv]];uv[[1,1]]]],1000];
(kernel 131)
>> 463972383196608{{TooBig,{2,{0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0}}},34359738368,8}
In[]:=
Counts[Last/@%]
Out[]=
11194,10162,12120,872,9109,1536,740,1469,13112,232,1814,1631,194,TooBig1,1712,51,67,242,206,213,272,221
In[]:=
KeySort[%]
Out[]=
51,67,740,872,9109,10162,11194,12120,13112,1469,1536,1631,1712,1814,194,206,213,221,232,242,272,TooBig1
In[]:=
FindPostTagFinalPlus[{0,IntegerDigits[463972383196608,2,50]},34]
Out[]=
{14200487232,6,{0,{0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0}}}

k=3 case

TSGQueueEvolveLength[{2,{{0},{0,2},{2,1,1}}},IntegerDigits[i,3,n],t_]

k=3

Timings:

In[]:=
With[{r=76},xpmax[Monitor[Flatten[Table[ParallelTable[{n,i}With[{u=TagLengthFunction3[{2,TakeList[IntegerDigits[r,3,6],{1,2,3}]}][IntegerDigits[i,3,n],100000]},{Length/@FindTransientRepeat[u,3],Max[u],Last[u]}],{i,0,3^n-1}],{n,5}]],n]]]//AbsoluteTiming
Out[]=
{10.9749,{{1,0}{{0,1},1,1},{2,0}{{1,1},2,1},{2,3}{{2,1},2,1},{2,6}{{7,1},4,1},{3,2}{{8,1},4,1},{3,9}{{9,1},4,1},{3,10}{{73,1},15,1},{5,11}{{74,1},15,1},{5,82}{{75,1},15,1},{5,91}{{121,1},15,1}}}
In[]:=
With[{r=76},xpmax[Monitor[Flatten[Table[ParallelTable[{n,i}With[{u=Length/@TSGDirectEvolveList[{2,TakeList[IntegerDigits[r,3,6],{1,2,3}]},IntegerDigits[i,3,n],100000]},{Length/@FindTransientRepeat[u,3],Max[u],Last[u]}],{i,0,3^n-1}],{n,5}]],n]]]//AbsoluteTiming
Out[]=
{3.62514,{{1,0}{{1,0},1,1},{2,0}{{2,0},2,1},{2,3}{{3,0},2,1},{2,6}{{8,0},4,1},{3,2}{{9,0},4,1},{3,9}{{10,0},4,1},{3,10}{{74,0},15,1},{5,11}{{75,0},15,1},{5,82}{{76,0},15,1},{5,91}{{122,0},15,1}}}
In[]:=
With[{r=76},xpmax[Monitor[Flatten[Table[ParallelTable[{n,i}With[{u=Length/@TSGDirectEvolveList[{2,TakeList[IntegerDigits[r,3,6],{1,2,3}]},IntegerDigits[i,3,n],100000]},{Length/@FindTransientRepeat[u,3],Max[u],Last[u]}],{i,0,3^n-1}],{n,9}]],n]]]//AbsoluteTiming
Out[]=
{66.4028,{{1,0}{{1,0},1,1},{2,0}{{2,0},2,1},{2,3}{{3,0},2,1},{2,6}{{8,0},4,1},{3,2}{{9,0},4,1},{3,9}{{10,0},4,1},{3,10}{{74,0},15,1},{5,11}{{75,0},15,1},{5,82}{{76,0},15,1},{5,91}{{122,0},15,1},{6,546}{{6627,0},181,1},{7,182}{{6628,0},181,1},{7,749}{{6629,0},181,1},{7,812}{{6630,0},181,1},{7,819}{{6631,0},181,1},{7,1468}{{6633,0},181,1}}}

To be run

In[]:=
xpmax[list_]:=list[[ResourceFunction["ProgressiveMaxPositions"][#[[2,1,1]]&/@list]]]
With[{r=76},xpmax[Monitor[Flatten[Table[ParallelTable[{n,i}With[{u=TagLengthFunction3[{2,TakeList[IntegerDigits[r,3,6],{1,2,3}]}][IntegerDigits[i,3,n],100000]},{Length/@FindTransientRepeat[u,3],Max[u],Last[u]}],{i,0,3^n-1}],{n,11,12}]],n]]]
Out[]=
{{11,0}{{11,0},11,1},{11,1}{{12,0},11,1},{11,2}{{26,0},11,1},{11,9}{{81,0},15,1},{11,82}{{82,0},15,1},{11,101}{{123,0},15,1},{11,182}{{4106,0},127,1},{11,1559}{{6618,0},181,1},{11,1638}{{6629,0},181,1},{11,6743}{{6630,0},181,1},{11,13214}{{6631,0},181,1},{11,60517}{{6632,0},181,1},{11,66348}{{6633,0},181,1},{11,72910}{{6636,0},181,1},{11,119566}{{6637,0},181,1},{12,374523}{{9343,0},131,1},{12,398310}{{20171,0},255,1}}
With[{r=76},xpmax[Monitor[Flatten[Table[ParallelTable[{n,i}With[{u=TagLengthFunction3[{2,TakeList[IntegerDigits[r,3,6],{1,2,3}]}][IntegerDigits[i,3,n],1000000]},{Length/@FindTransientRepeat[u,3],Max[u],Last[u]}],{i,0,3^n-1}],{n,13,14}]],n]]]

Harvesting Large Results

In[]:=
Notebooks[]
Out[]=
NotebookObject
TagSystems-28.nb
,NotebookObject
Untitled-15
,NotebookObject
TagSystems-29-MLmap.nb
,NotebookObject
NotebookImport
,NotebookObject
Code-01.nb
,NotebookObject
Draft-02Comments.nb
,NotebookObject
TagSystems-23-search.nb
,NotebookObject
TagSystems-26.nb
,NotebookObject
Untitled-9
,NotebookObject
TagSystems-27.nb
,NotebookObject
Untitled-12
,NotebookObject
Untitled-2
,NotebookObject
TWJ---CreateAssociation.nb
,NotebookObject
Untitled-7
,NotebookObject
Draft-02.nb
,NotebookObject
ProjectList-01.nb
,NotebookObject
Draft-08.nb
,NotebookObject
Messages

In[]:=
allres=#[[1,2]]&/@NotebookImportNotebookObject
Untitled-13
,"Print""HeldExpression";
In[]:=
Length[allres]
Out[]=
3394

​

In[]:=
allres[[1]]
Out[]=
{2,{0,0,0,0,0,1,0,1,1,1,0,1,0,0,0,1,0,1,0,0,1,1,0,1,0}},

​

Results

(kernel 78)
>> {2,{0,0,0,0,0,1,0,1,1,1,0,1,0,0,0,1,0,1,0,0,1,1,0,1,0}},

(kernel 79)
>> {2,{0,0,0,0,1,1,1,0,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,0,1}},

(kernel 19)
>> {2,{0,0,1,0,1,1,1,1,0,1,0,1,0,1,1,1,1,1,1,1,1,1,1,0,1}},


Compiled Versions

Enumerate states both with and without last blank....
This needs {0, values} as input:

Block Case

Check if TooBig occurs.....
SEEMS NOT TO BE WORKING.....

k=3 Case